library(tidyverse)
library(knitr)
library(kableExtra)
ach <- read.csv("wash_data_ACH.csv")
state_data <- read.csv("wash_data_state.csv")
state_data_long <- read.csv("wash_data_state_percents.csv")
Research Question:
How do maternal and infant health outcomes vary across Washington’s
Accountable Communities of Health (ACH), and what can we learn about
disparities from these metrics?
Purpose:
This dashboard aims to provide actionable insights into maternal and
infant health disparities across Washington by visualizing key metrics
such as low birth weight, preterm birth rates, smoking prevalence, and
prenatal care access.
ACH Definition:
Accountable Communities of Health (ACH) are regional coalitions in
Washington State that work collaboratively to improve health outcomes
and address health disparities within their communities.
state_data_long %>%
kable(
col.names = c("Metric", "State Value"),
format = "html"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = TRUE, # Fill the container width
font_size = 18 # Increase font size for readability
) %>%
add_header_above(c("Statewide Maternal and Infant Health Statistics" = 2), align = "l") # Left-align the header
| Metric | State Value |
|---|---|
| Low Birth Weight (%) | 5.37 |
| Very Low Birth Weight (%) | 0.79 |
| Smoking During Pregnancy (%) | 5.52 |
| Preterm Birth (%) | 8.90 |
| Very Preterm Birth (%) | 1.16 |
| Prenatal Care Access (%) | 73.98 |
library(ggrepel)
ach %>%
ggplot(aes(x = LBW_Percent, y = Smoke_Percent, label = ACH)) +
geom_point(size = 3, color = "blue", alpha = 0.5) +
geom_text_repel(size = 4, max.overlaps = 10) + # Automatically adjust labels
labs(
title = "Low Birth Weight & Smoking by ACH",
x = "Low Birth Weight (%)",
y = "Pregnancy Smoking (%)"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5) # Center align the title
)
library(plotly)
# Calculate the mean LBW Percent from state_data
state_mean_LBW <- state_data %>%
pull(LBW_Percent)
# Create an interactive plot with labels always visible
plot_ly(
data = ach,
x = ~LBW_Percent,
y = ~Smoke_Percent,
type = 'scatter',
mode = 'markers+text', # Add both markers and text
text = ~ACH, # Text labels (ACH names)
textposition = 'top center', # Position the labels above the points
marker = list(size = 10, color = 'blue') # Customize marker size and color
) %>%
add_lines(
x = state_mean_LBW, # Add vertical line at mean
y = ~Smoke_Percent, # Span the entire y-axis
line = list(color = 'red', dash = 'dash'), # Dashed red line
inherit = FALSE, # Prevent inheriting aesthetics from main data
showlegend = FALSE # Do not show legend for this line
) %>%
layout(
title = "Low Birth Weight & Smoking by ACH",
xaxis = list(title = "Low Birth Weight (%)"),
yaxis = list(title = "Pregnancy Smoking (%)"),
annotations = list(
x = state_mean_LBW, # Keep the x position at the state mean
y = max(ach$Smoke_Percent) + 1, # Move the label higher (adjust y position)
text = paste("State Mean:", round(state_mean_LBW, 2)), # Add mean label
showarrow = TRUE,
arrowhead = 2,
ax = 0, # x-offset for the arrow (no horizontal movement)
ay = -30 # Increase y-offset to move the arrow higher
)
)
library(plotly)
# Create an interactive plot with labels always visible
plot_ly(
data = ach,
x = ~LBW_Percent,
y = ~Prenatal_Care_Percent,
type = 'scatter',
mode = 'markers+text', # Add both markers and text
text = ~ACH, # Text labels (ACH names)
textposition = 'top center', # Position the labels above the points
marker = list(size = 10, color = 'blue') # Customize marker size and color
) %>%
layout(
title = "Low Birth Weight & Prenatal Care by ACH",
xaxis = list(title = "Low Birth Weight (%)"),
yaxis = list(title = "Prenatal Care (%)")
)
library(plotly)
# Calculate the mean LBW Percent from state_data
state_mean_LBW <- state_data %>%
pull(LBW_Percent)
# Create the scatter plot
plot_ly(
data = ach,
x = ~LBW_Percent, # LBW Percent on the x-axis
y = ~ACH, # ACH regions on the y-axis
type = 'scatter',
mode = 'markers+text', # Add both points and labels
text = ~LBW_Percent, # Show LBW Percent as text
textposition = 'right', # Position labels to the right of points
marker = list(size = 10, color = 'blue') # Customize marker size and color
) %>%
add_lines(
x = state_mean_LBW, # Add vertical line at mean
y = ~ACH, # Span the entire y-axis
line = list(color = 'red', dash = 'dash'), # Dashed red line
inherit = FALSE, # Prevent inheriting aesthetics from main data
showlegend = FALSE # Do not show legend for this line
) %>%
layout(
title = "Low Birth Weight Percent by ACH",
xaxis = list(title = "LBW Percent (%)"),
yaxis = list(title = "ACH Region"),
annotations = list(
x = state_mean_LBW, # Position annotation at mean line
y = max(1:length(ach$ACH)), # Place annotation above the chart
text = paste("State Mean:", round(state_mean_LBW, 2)), # Add mean label
showarrow = TRUE,
arrowhead = 2,
ax = 0, ay = -40
)
)
# Calculate the mean VLBW Percent from state_data
state_mean_VLBW <- state_data %>%
pull(VLBW_Percent)
# Create the scatter plot
plot_ly(
data = ach,
x = ~VLBW_Percent, # VLBW Percent on the x-axis
y = ~ACH, # ACH regions on the y-axis
type = 'scatter',
mode = 'markers+text', # Add both points and labels
text = ~VLBW_Percent, # Show VLBW Percent as text
textposition = 'right', # Position labels to the right of points
marker = list(size = 10, color = 'blue') # Customize marker size and color
) %>%
add_lines(
x = state_mean_VLBW, # Add vertical line at mean
y = ~ACH, # Span the entire y-axis
line = list(color = 'red', dash = 'dash'), # Dashed red line
inherit = FALSE, # Prevent inheriting aesthetics from main data
showlegend = FALSE # Do not show legend for this line
) %>%
layout(
title = "Very Low Birth Weight Percent by ACH",
xaxis = list(title = "VLBW Percent (%)"),
yaxis = list(title = "ACH Region"),
annotations = list(
x = state_mean_VLBW, # Position annotation at mean line
y = max(1:length(ach$ACH)), # Place annotation above the chart
text = paste("State Mean:", round(state_mean_VLBW, 2)), # Add mean label
showarrow = TRUE,
arrowhead = 2,
ax = 0, ay = -40
)
)
# Calculate the mean PTB Percent from state_data
state_mean_PTB <- state_data %>%
pull(PTB_Percent)
# Create the scatter plot
plot_ly(
data = ach,
x = ~PTB_Percent, # PTB Percent on the x-axis
y = ~ACH, # ACH regions on the y-axis
type = 'scatter',
mode = 'markers+text', # Add both points and labels
text = ~PTB_Percent, # Show PTB Percent as text
textposition = 'right', # Position labels to the right of points
marker = list(size = 10, color = 'blue') # Customize marker size and color
) %>%
add_lines(
x = state_mean_PTB, # Add vertical line at mean
y = ~ACH, # Span the entire y-axis
line = list(color = 'red', dash = 'dash'), # Dashed red line
inherit = FALSE, # Prevent inheriting aesthetics from main data
showlegend = FALSE # Do not show legend for this line
) %>%
layout(
title = "Preterm Birth Percent by ACH",
xaxis = list(title = "PTB Percent (%)"),
yaxis = list(title = "ACH Region"),
annotations = list(
x = state_mean_PTB, # Position annotation at mean line
y = max(1:length(ach$ACH)), # Place annotation above the chart
text = paste("State Mean:", round(state_mean_PTB, 2)), # Add mean label
showarrow = TRUE,
arrowhead = 2,
ax = 0, ay = -40
)
)
# Calculate the mean VPTB Percent from state_data
state_mean_VPTB <- state_data %>%
pull(VPTB_Percent)
# Create the scatter plot
plot_ly(
data = ach,
x = ~VPTB_Percent, # VPTB Percent on the x-axis
y = ~ACH, # ACH regions on the y-axis
type = 'scatter',
mode = 'markers+text', # Add both points and labels
text = ~VPTB_Percent, # Show VPTB Percent as text
textposition = 'right', # Position labels to the right of points
marker = list(size = 10, color = 'blue') # Customize marker size and color
) %>%
add_lines(
x = state_mean_VPTB, # Add vertical line at mean
y = ~ACH, # Span the entire y-axis
line = list(color = 'red', dash = 'dash'), # Dashed red line
inherit = FALSE, # Prevent inheriting aesthetics from main data
showlegend = FALSE # Do not show legend for this line
) %>%
layout(
title = "Very Preterm Birth Percent by ACH",
xaxis = list(title = "VPTB Percent (%)"),
yaxis = list(title = "ACH Region"),
annotations = list(
x = state_mean_VPTB, # Position annotation at mean line
y = max(1:length(ach$ACH)), # Place annotation above the chart
text = paste("State Mean:", round(state_mean_VPTB, 2)), # Add mean label
showarrow = TRUE,
arrowhead = 2,
ax = 0, ay = -40
)
)
library(plotly)
# Pivot the data to long format
Pierce <- ach %>% filter(ACH == "Pierce") %>% select(-ACH) %>%
pivot_longer(
cols = everything(), # Pivot all columns
names_to = "Metric", # Name for the metric column
values_to = "Value" # Name for the value column
) %>%
filter(str_detect(Metric, "Percent")) %>% # Filter relevant metrics
mutate(Metric = fct_reorder(Metric, Value)) # Reorder Metric by Value
# Create a bar chart
plot_ly(
data = Pierce,
x = ~Metric, # Metrics on x-axis
y = ~Value, # Values on y-axis
type = 'bar', # Bar chart type
text = ~paste(Value), # Hover text
marker = list(color = 'steelblue') # Bar color
) %>%
layout(
title = "Pierce Comparison of Health Metrics",
xaxis = list(
title = "Metric",
tickangle = -45 # Rotate x-axis labels for readability
),
yaxis = list(title = "Value"),
margin = list(b = 150) # Add margin for rotated labels
)
library(plotly)
# Pivot the data to long format
King <- ach %>% filter(ACH == "King") %>% select(-ACH) %>%
pivot_longer(
cols = everything(), # Pivot all columns
names_to = "Metric", # Name for the metric column
values_to = "Value" # Name for the value column
) %>%
filter(str_detect(Metric, "Percent")) %>% # Filter relevant metrics
mutate(Metric = fct_reorder(Metric, Value)) # Reorder Metric by Value
# Create a bar chart
plot_ly(
data = King,
x = ~Metric, # Metrics on x-axis
y = ~Value, # Values on y-axis
type = 'bar', # Bar chart type
text = ~paste(Value), # Hover text
marker = list(color = 'steelblue') # Bar color
) %>%
layout(
title = "King Comparison of Health Metrics",
xaxis = list(
title = "Metric",
tickangle = -45 # Rotate x-axis labels for readability
),
yaxis = list(title = "Value"),
margin = list(b = 150) # Add margin for rotated labels
)